Loading Packages

library(tidyverse)
── Attaching core tidyverse packages ─────────────────────────────────── tidyverse 2.0.0 ──
✔ dplyr     1.1.3     ✔ readr     2.1.4
✔ forcats   1.0.0     ✔ stringr   1.5.0
✔ ggplot2   3.4.4     ✔ tibble    3.2.1
✔ lubridate 1.9.3     ✔ tidyr     1.3.0
✔ purrr     1.0.2     ── Conflicts ───────────────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::lag()    masks stats::lag()
ℹ Use the ]8;;http://conflicted.r-lib.org/conflicted package]8;; to force all conflicts to become errors
library(dplyr)
library(sf)
Linking to GEOS 3.11.2, GDAL 3.6.2, PROJ 9.2.0; sf_use_s2() is TRUE
library(janitor)

Attaching package: ‘janitor’

The following objects are masked from ‘package:stats’:

    chisq.test, fisher.test
library(here)
here() starts at C:/Users/lucas/OneDrive/Desktop/ds_241_f23

Loading Data

bikeshare_sept23 <- read.csv(here("data_raw", "202309-capitalbikeshare-tripdata.csv"))

Slicing off first 10000 points to examine

bikeshare_sept2302 = bikeshare_sept23  |>
  slice(1:100000) 

Plotting Points on standard grid

  ggplot(bikeshare_sept2302, mapping = aes(x = start_lng, y = start_lat))+
  geom_point()

Preparing points for map plotting

points = st_as_sf(bikeshare_sept2302, coords = c("start_lng", "start_lat"), crs = 4326)
plot(st_geometry(points), pch = 16, col = "navy")

Plotting all points on the D.C. map

library(OpenStreetMap)

upperLeft = c(39.12, -77.38)

lowerRight = c(38.77, -76.86)

base_map  = openmap(upperLeft, lowerRight, type="osm")

plot(base_map)

points = st_transform(points, osm())

plot(st_geometry(points), pch=16, col="navy", cex=0.5, add=T)

Separating timestamps to access hour

bikeshare_sept2302 <- bikeshare_sept2302 %>%
  separate(started_at, into = c("start_date", "start_time"), sep = 10, remove = FALSE)
bikeshare_sept2302 <- bikeshare_sept2302 %>%
  separate(ended_at, into = c("end_date", "end_time"), sep = 10, remove = FALSE)
bikeshare_sept2302 <- bikeshare_sept2302 %>%
  separate(start_time, into = c("start_hour", "start_inhour"), sep = 3, remove = FALSE)
bikeshare_sept2302 <- bikeshare_sept2302 %>%
  separate(end_time, into = c("end_hour", "end_inhour"), sep = 3, remove = FALSE)

Mutating a new variable to turn string segment into a numeric value

bikeshare_sept2302 <- bikeshare_sept2302 %>%
  mutate(begin_hr = case_when(
    start_hour == " 01" ~ 01,
    start_hour == " 02" ~ 02,
    start_hour == " 03" ~ 03,
    start_hour == " 04" ~ 04,
    start_hour == " 05" ~ 05,
    start_hour == " 06" ~ 06,
    start_hour == " 07" ~ 07,
    start_hour == " 08" ~ 08,
    start_hour == " 09" ~ 09,
    start_hour == " 10" ~ 10,
    start_hour == " 11" ~ 11,
    start_hour == " 12" ~ 12,
    start_hour == " 13" ~ 13,
    start_hour == " 14" ~ 14,
    start_hour == " 15" ~ 15,
    start_hour == " 16" ~ 16,
    start_hour == " 17" ~ 17,
    start_hour == " 18" ~ 18,
    start_hour == " 19" ~ 19,
    start_hour == " 20" ~ 20,
    start_hour == " 21" ~ 21,
    start_hour == " 22" ~ 22,
    start_hour == " 23" ~ 23,
    start_hour == " 00" ~ 00
  ))

Grouping hours into morning and afternoon

bikeshare_sept2302 <- bikeshare_sept2302 %>%
  mutate(tod = case_when(
  begin_hr %in% c(0,1,2,3,4,5) ~ 1,
  begin_hr %in% c(6,7,8,9,10,11) ~ 2,
  begin_hr %in% c(12,13,14,15,16,17) ~ 3,
  begin_hr %in% c(18,19,20,21,22,23) ~ 4
    ))

Preparing points to be plotted again

points = st_as_sf(bikeshare_sept2302, coords = c("start_lng", "start_lat"), crs = 4326)
plot(st_geometry(points), pch = 16, col = "navy")

Plotting points again on D.C. map, this time distinguishing them by color, where red is morning and black is afternoon.

palette = c("red", "black", "blue", "green")

names(palette) = unique(points$tod)

upperLeft = c(39.13, -77.38)

lowerRight = c(38.77, -76.84)

base_map  = openmap(upperLeft, lowerRight, type="osm")

plot(base_map)

points = st_transform(points, osm())

plot(st_geometry(points), pch=16, col=palette[points$tod], cex=0.5, add=T)

LS0tDQp0aXRsZTogIkluIENsYXNzIEV4ZXJjaXNlOiAxOC0xMC0yMDIzIg0KbmFtZTogIkx1Y2FzLCBSeWFuLCBTZWFuIg0KZGF0ZTogIjE4LTEwLTIwMjMiDQpvdXRwdXQ6IGh0bWxfbm90ZWJvb2sNCi0tLQ0KDQojIExvYWRpbmcgUGFja2FnZXMNCmBgYHtyfQ0KbGlicmFyeSh0aWR5dmVyc2UpDQpsaWJyYXJ5KGRwbHlyKQ0KbGlicmFyeShzZikNCmxpYnJhcnkoamFuaXRvcikNCmxpYnJhcnkoaGVyZSkNCmBgYA0KDQojIExvYWRpbmcgRGF0YQ0KYGBge3J9DQpiaWtlc2hhcmVfc2VwdDIzIDwtIHJlYWQuY3N2KGhlcmUoImRhdGFfcmF3IiwgIjIwMjMwOS1jYXBpdGFsYmlrZXNoYXJlLXRyaXBkYXRhLmNzdiIpKQ0KYGBgDQoNCiMgU2xpY2luZyBvZmYgZmlyc3QgMTAwMDAgcG9pbnRzIHRvIGV4YW1pbmUNCmBgYHtyfQ0KYmlrZXNoYXJlX3NlcHQyMzAyID0gYmlrZXNoYXJlX3NlcHQyMyAgfD4NCiAgc2xpY2UoMToxMDAwMDApIA0KYGBgDQoNCiMgUGxvdHRpbmcgUG9pbnRzIG9uIHN0YW5kYXJkIGdyaWQNCmBgYHtyfQ0KICBnZ3Bsb3QoYmlrZXNoYXJlX3NlcHQyMzAyLCBtYXBwaW5nID0gYWVzKHggPSBzdGFydF9sbmcsIHkgPSBzdGFydF9sYXQpKSsNCiAgZ2VvbV9wb2ludCgpDQpgYGANCg0KIyBQcmVwYXJpbmcgcG9pbnRzIGZvciBtYXAgcGxvdHRpbmcNCmBgYHtyfQ0KcG9pbnRzID0gc3RfYXNfc2YoYmlrZXNoYXJlX3NlcHQyMzAyLCBjb29yZHMgPSBjKCJzdGFydF9sbmciLCAic3RhcnRfbGF0IiksIGNycyA9IDQzMjYpDQpwbG90KHN0X2dlb21ldHJ5KHBvaW50cyksIHBjaCA9IDE2LCBjb2wgPSAibmF2eSIpDQpgYGANCg0KIyBQbG90dGluZyBhbGwgcG9pbnRzIG9uIHRoZSBELkMuIG1hcA0KYGBge3J9DQpsaWJyYXJ5KE9wZW5TdHJlZXRNYXApDQoNCnVwcGVyTGVmdCA9IGMoMzkuMTIsIC03Ny4zOCkNCg0KbG93ZXJSaWdodCA9IGMoMzguNzcsIC03Ni44NikNCg0KYmFzZV9tYXAgID0gb3Blbm1hcCh1cHBlckxlZnQsIGxvd2VyUmlnaHQsIHR5cGU9Im9zbSIpDQoNCnBsb3QoYmFzZV9tYXApDQoNCnBvaW50cyA9IHN0X3RyYW5zZm9ybShwb2ludHMsIG9zbSgpKQ0KDQpwbG90KHN0X2dlb21ldHJ5KHBvaW50cyksIHBjaD0xNiwgY29sPSJuYXZ5IiwgY2V4PTAuNSwgYWRkPVQpDQpgYGANCiMgU2VwYXJhdGluZyB0aW1lc3RhbXBzIHRvIGFjY2VzcyBob3VyDQpgYGB7cn0NCmJpa2VzaGFyZV9zZXB0MjMwMiA8LSBiaWtlc2hhcmVfc2VwdDIzMDIgJT4lDQogIHNlcGFyYXRlKHN0YXJ0ZWRfYXQsIGludG8gPSBjKCJzdGFydF9kYXRlIiwgInN0YXJ0X3RpbWUiKSwgc2VwID0gMTAsIHJlbW92ZSA9IEZBTFNFKQ0KYmlrZXNoYXJlX3NlcHQyMzAyIDwtIGJpa2VzaGFyZV9zZXB0MjMwMiAlPiUNCiAgc2VwYXJhdGUoZW5kZWRfYXQsIGludG8gPSBjKCJlbmRfZGF0ZSIsICJlbmRfdGltZSIpLCBzZXAgPSAxMCwgcmVtb3ZlID0gRkFMU0UpDQpiaWtlc2hhcmVfc2VwdDIzMDIgPC0gYmlrZXNoYXJlX3NlcHQyMzAyICU+JQ0KICBzZXBhcmF0ZShzdGFydF90aW1lLCBpbnRvID0gYygic3RhcnRfaG91ciIsICJzdGFydF9pbmhvdXIiKSwgc2VwID0gMywgcmVtb3ZlID0gRkFMU0UpDQpiaWtlc2hhcmVfc2VwdDIzMDIgPC0gYmlrZXNoYXJlX3NlcHQyMzAyICU+JQ0KICBzZXBhcmF0ZShlbmRfdGltZSwgaW50byA9IGMoImVuZF9ob3VyIiwgImVuZF9pbmhvdXIiKSwgc2VwID0gMywgcmVtb3ZlID0gRkFMU0UpDQpgYGANCg0KIyBNdXRhdGluZyBhIG5ldyB2YXJpYWJsZSB0byB0dXJuIHN0cmluZyBzZWdtZW50IGludG8gYSBudW1lcmljIHZhbHVlDQpgYGB7cn0NCmJpa2VzaGFyZV9zZXB0MjMwMiA8LSBiaWtlc2hhcmVfc2VwdDIzMDIgJT4lDQogIG11dGF0ZShiZWdpbl9ociA9IGNhc2Vfd2hlbigNCiAgICBzdGFydF9ob3VyID09ICIgMDEiIH4gMDEsDQogICAgc3RhcnRfaG91ciA9PSAiIDAyIiB+IDAyLA0KICAgIHN0YXJ0X2hvdXIgPT0gIiAwMyIgfiAwMywNCiAgICBzdGFydF9ob3VyID09ICIgMDQiIH4gMDQsDQogICAgc3RhcnRfaG91ciA9PSAiIDA1IiB+IDA1LA0KICAgIHN0YXJ0X2hvdXIgPT0gIiAwNiIgfiAwNiwNCiAgICBzdGFydF9ob3VyID09ICIgMDciIH4gMDcsDQogICAgc3RhcnRfaG91ciA9PSAiIDA4IiB+IDA4LA0KICAgIHN0YXJ0X2hvdXIgPT0gIiAwOSIgfiAwOSwNCiAgICBzdGFydF9ob3VyID09ICIgMTAiIH4gMTAsDQogICAgc3RhcnRfaG91ciA9PSAiIDExIiB+IDExLA0KICAgIHN0YXJ0X2hvdXIgPT0gIiAxMiIgfiAxMiwNCiAgICBzdGFydF9ob3VyID09ICIgMTMiIH4gMTMsDQogICAgc3RhcnRfaG91ciA9PSAiIDE0IiB+IDE0LA0KICAgIHN0YXJ0X2hvdXIgPT0gIiAxNSIgfiAxNSwNCiAgICBzdGFydF9ob3VyID09ICIgMTYiIH4gMTYsDQogICAgc3RhcnRfaG91ciA9PSAiIDE3IiB+IDE3LA0KICAgIHN0YXJ0X2hvdXIgPT0gIiAxOCIgfiAxOCwNCiAgICBzdGFydF9ob3VyID09ICIgMTkiIH4gMTksDQogICAgc3RhcnRfaG91ciA9PSAiIDIwIiB+IDIwLA0KICAgIHN0YXJ0X2hvdXIgPT0gIiAyMSIgfiAyMSwNCiAgICBzdGFydF9ob3VyID09ICIgMjIiIH4gMjIsDQogICAgc3RhcnRfaG91ciA9PSAiIDIzIiB+IDIzLA0KICAgIHN0YXJ0X2hvdXIgPT0gIiAwMCIgfiAwMA0KICApKQ0KYGBgDQoNCiMgR3JvdXBpbmcgaG91cnMgaW50byBtb3JuaW5nIGFuZCBhZnRlcm5vb24NCmBgYHtyfQ0KYmlrZXNoYXJlX3NlcHQyMzAyIDwtIGJpa2VzaGFyZV9zZXB0MjMwMiAlPiUNCiAgbXV0YXRlKHRvZCA9IGNhc2Vfd2hlbigNCiAgYmVnaW5faHIgJWluJSBjKDAsMSwyLDMsNCw1KSB+IDEsDQogIGJlZ2luX2hyICVpbiUgYyg2LDcsOCw5LDEwLDExKSB+IDIsDQogIGJlZ2luX2hyICVpbiUgYygxMiwxMywxNCwxNSwxNiwxNykgfiAzLA0KICBiZWdpbl9ociAlaW4lIGMoMTgsMTksMjAsMjEsMjIsMjMpIH4gNA0KICAgICkpDQpgYGANCg0KIyBQcmVwYXJpbmcgcG9pbnRzIHRvIGJlIHBsb3R0ZWQgYWdhaW4NCmBgYHtyfQ0KcG9pbnRzID0gc3RfYXNfc2YoYmlrZXNoYXJlX3NlcHQyMzAyLCBjb29yZHMgPSBjKCJzdGFydF9sbmciLCAic3RhcnRfbGF0IiksIGNycyA9IDQzMjYpDQpwbG90KHN0X2dlb21ldHJ5KHBvaW50cyksIHBjaCA9IDE2LCBjb2wgPSAibmF2eSIpDQpgYGANCiMgUGxvdHRpbmcgcG9pbnRzIGFnYWluIG9uIEQuQy4gbWFwLCB0aGlzIHRpbWUgZGlzdGluZ3Vpc2hpbmcgdGhlbSBieSBjb2xvciwgd2hlcmUgcmVkIGlzIG1vcm5pbmcgYW5kIGJsYWNrIGlzIGFmdGVybm9vbi4NCmBgYHtyfQ0KcGFsZXR0ZSA9IGMoInJlZCIsICJibGFjayIsICJibHVlIiwgImdyZWVuIikNCg0KbmFtZXMocGFsZXR0ZSkgPSB1bmlxdWUocG9pbnRzJHRvZCkNCg0KdXBwZXJMZWZ0ID0gYygzOS4xMywgLTc3LjM4KQ0KDQpsb3dlclJpZ2h0ID0gYygzOC43NywgLTc2Ljg0KQ0KDQpiYXNlX21hcCAgPSBvcGVubWFwKHVwcGVyTGVmdCwgbG93ZXJSaWdodCwgdHlwZT0ib3NtIikNCg0KcGxvdChiYXNlX21hcCkNCg0KcG9pbnRzID0gc3RfdHJhbnNmb3JtKHBvaW50cywgb3NtKCkpDQoNCnBsb3Qoc3RfZ2VvbWV0cnkocG9pbnRzKSwgcGNoPTE2LCBjb2w9cGFsZXR0ZVtwb2ludHMkdG9kXSwgY2V4PTAuNSwgYWRkPVQpDQpgYGANCg0K